library(circlize)
## ========================================
## circlize version 0.4.9
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================
library(tidyverse)
## ── Attaching packages ──────────────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.0 ✓ purrr 0.3.4
## ✓ tibble 3.0.1 ✓ dplyr 0.8.5
## ✓ tidyr 1.0.2 ✓ stringr 1.4.0
## ✓ readr 1.3.1 ✓ forcats 0.5.0
## ── Conflicts ─────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(gt)
library(skimr)
library(officer)
source("01_prep-data.R")
##
## Attaching package: 'readxl'
## The following object is masked from 'package:officer':
##
## read_xlsx
##
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
## New names:
## * `` -> ...1
## * `` -> ...2
## * `` -> ...3
## * `` -> ...4
## * `` -> ...5
## * ...
## Parsed with column specification:
## cols(
## `Global Code` = col_character(),
## `Global Name` = col_character(),
## `Region Code` = col_character(),
## `Region Name` = col_character(),
## `Sub-region Code` = col_character(),
## `Sub-region Name` = col_character(),
## `Intermediate Region Code` = col_character(),
## `Intermediate Region Name` = col_character(),
## `Country or Area` = col_character(),
## `M49 Code` = col_character(),
## `ISO-alpha3 Code` = col_character(),
## `Least Developed Countries (LDC)` = col_character(),
## `Land Locked Developing Countries (LLDC)` = col_character(),
## `Small Island Developing States (SIDS)` = col_character(),
## `Developed / Developing Countries` = col_character()
## )
## Warning: 1 parsing failure.
## row col expected actual file
## 118 -- 15 columns 11 columns '/Users/petr/carchive/migration-diagram/data-input/un_list.tsv'
## Warning: NAs introduced by coercion
Načíst data
source("02_prep-colours.R")
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
df <- read_rds("data-processed/orig-dest-new.rds")
Upravit data
dfl <- df %>%
filter(value > 0) %>%
drop_na() %>%
select(from = origin, to = destination, value)
dfl
Zkontrolovat, jestli jsou řádky unikátní
distinct(dfl, from, to)
Počet řádků stejný, jako u konečného datasetu, takže fajn.
Vykreslit graf:
circos.clear()
chordDiagram(df)
## There are more than one numeric columns in the data frame. Take the
## first two numeric columns and draw the link ends with unequal width.
Hmm, to vypadá fakt divně a nevím proč. Zkusíme funkci stavěnou na data frame, ne na matici:
circos.clear()
chordDiagramFromDataFrame(dfl, directional = 1)
dfl_filtered <- dfl %>%
ungroup() %>%
filter(value > 8e4) %>%
mutate(value = value/1e5,
# to = str_replace(to, "Europe", "čáěšžěšéí"),
# from = str_replace(from, "Europe", "čáěšžěšéí"),
from = str_replace(from, "South-eastern Asia", "SouthEastern Asia") %>%
str_wrap(10),
to = str_replace(to, "South-eastern Asia", "SouthEastern Asia") %>%
str_wrap(10))
dfl_filtered
setdiff(dfl_filtered$from, dfl_filtered$to)
## [1] "Caribbean" "Central\nAmerica" "Central\nAsia" "Middle\nAfrica"
## [5] "South\nAmerica" "Southern\nAsia" "Southern\nEurope"
setdiff(dfl_filtered$to, dfl_filtered$from)
## [1] "Northern\nAmerica"
scales::show_col(cols, borders = F)
names(cols)
## [1] "yellow" "orange" "wine" "brown" "purple"
## [6] "blue_light" "blue_dark" "green" "yellow_l" "orange_l"
## [11] "wine_l" "brown_l" "purple_l" "blue_light_l" "blue_dark_l"
## [16] "green_l"
nazevnik <- tribble(~ordered_en, ~ordered_cz, ~color_old, ~color,
"Eastern Africa","Východní Afrika","darkgreen",cols[["yellow"]],
"Middle Africa","Střední Afrika","chartreuse4",cols[["yellow_l"]],
"Northern Africa","Severní Afrika","chartreuse3",cols[["orange"]],
"Southern Africa","Jižní Afrika","darkolivegreen",cols[["orange_l"]],
"Western Africa","Západní Afrika","darkolivegreen3","#e6bd33",
"Central Asia","Střední Asie","blue4",cols[["blue_dark"]],
"Eastern Asia","Východní Asie","blue1",cols[["blue_dark_l"]],
"Southern Asia","Jižní Asie","cornflowerblue",cols[["blue_light_l"]],
"SouthEastern Asia","Jihovýchodní Asie","blue1",cols[["blue_light"]],
"Western Asia","Západní Asie","deepskyblue","#023FA5",
"Eastern Europe","Východní Evropa","brown3",cols[["brown_l"]],
"Northern Europe","Severní Evropa","brown1",cols[["brown"]],
"Southern Europe","Jižní Evropa","coral",cols[["purple"]],
"Western Europe","Západní Evropa","darkred",cols[["purple_l"]],
"Caribbean","Karibik","blueviolet",cols[["wine"]],
"Central America","Střední Amerika","darkmagenta",cols[["green_l"]],
"South America","Jižní Amerika","darkorchid2","#006600",
"Northern America","Severní Amerika","darksalmon",cols[["green"]],
"Oceania","Oceánie","deeppink3", cols[["wine_l"]]) %>%
mutate(label_wrapped_en = str_wrap(ordered_en, 10),
label_wrapped_cz = str_wrap(ordered_cz, 10))
setdiff(nazevnik$label_wrapped_en, dfl_filtered$from)
## [1] "Southern\nAfrica" "Northern\nAmerica" "Oceania"
setdiff(dfl_filtered$from, nazevnik$label_wrapped_en)
## character(0)
setdiff(dfl_filtered$to, nazevnik$label_wrapped_en)
## character(0)
length(unique(nazevnik$label_wrapped_cz)) == length(nazevnik$label_wrapped_cz)
## [1] TRUE
# from https://stackoverflow.com/questions/31943102/rotate-labels-in-a-chorddiagram-r-circlize
make_circle_plot <- function(cz = FALSE) {
barvy_grid <- nazevnik$color
names(barvy_grid) <- if(cz) nazevnik$label_wrapped_cz else
nazevnik$label_wrapped_en
barvy_links <- dfl_filtered %>%
left_join(nazevnik %>% rename(from = label_wrapped_en)) %>%
pull(color)
if(cz) {
plot_data <- dfl_filtered %>%
left_join(nazevnik %>% select(from = label_wrapped_en,
label_wrapped_cz)) %>%
select(-from) %>%
rename(from = label_wrapped_cz) %>%
left_join(nazevnik %>% select(to = label_wrapped_en,
label_wrapped_cz)) %>%
select(-to) %>%
rename(to = label_wrapped_cz) %>%
select(to, from, value)
} else {
plot_data <- dfl_filtered %>%
select(to, from, value)
}
# print(plot_data)
order_list <- if(cz) {nazevnik$label_wrapped_cz
} else {
nazevnik$label_wrapped_en
}
# plot_data$to %in% order_list
# plot_data$from %in% order_list
par(lheight = .8)
chordDiagramFromDataFrame(plot_data,
directional = -1,
diffHeight = uh(-3, "mm"),
link.arr.type = "triangle",
link.arr.width = .30,
link.arr.length = .30,
link.arr.lwd = 2,
# link.arr.col = barvy_links,
link.arr.col = c(rep(NA, 10),
"#853946",
rep(NA, 9),
"#023FA5",
rep(NA, 3),
"#023FA5",
rep(NA, nrow(plot_data)-4-21)),
direction.type = "arrows+diffHeight",
grid.col = barvy_grid,
col = barvy_links,
transparency = .2,
link.lwd = 2,
link.border = "white",
order = order_list,
annotationTrack = "grid",
preAllocateTracks = 1)
circos.trackPlotRegion(track.index = 1, panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
ylim = get.cell.meta.data("ylim")
sector.name = get.cell.meta.data("sector.index")
circos.text(mean(xlim), ylim[1] + .4, sector.name,
facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5))
circos.axis(h = "top", labels.cex = 0.5, major.at = seq(0, 100, by = 5),
sector.index = sector.name, track.index = 2, minor.ticks = 4)
}, bg.border = NA)
# return(plot_data)
}
make_circle_plot(cz = FALSE)
## Joining, by = "from"
cairo_pdf(file = "chart-output/circle_en.pdf", width = 8, height = 8)
make_circle_plot(cz = FALSE)
## Joining, by = "from"
dev.off()
## quartz_off_screen
## 2
make_circle_plot(cz = FALSE)
## Joining, by = "from"
cairo_pdf(file = "chart-output/circle_cz.pdf", width = 8, height = 8)
make_circle_plot(cz = TRUE)
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
dev.off()
## quartz_off_screen
## 2
make_circle_plot(cz = TRUE)
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
ragg::agg_tiff(filename = "chart-output/circle_en.tiff",
width = 297, height = 297, units = "mm", res = 300, pointsize = 16)
make_circle_plot(cz = FALSE)
## Joining, by = "from"
dev.off()
## quartz_off_screen
## 2
ragg::agg_tiff(filename = "chart-output/circle_cz.tiff",
width = 297, height = 297, units = "mm", res = 300, pointsize = 16)
make_circle_plot(cz = TRUE)
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
dev.off()
## quartz_off_screen
## 2
svglite::svglite(file = "chart-output/circle_cz.svg", width = 8, height = 8)
make_circle_plot(cz = TRUE)
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
dev.off()
## quartz_off_screen
## 2
svglite::svglite(file = "chart-output/circle_en.svg", width = 8, height = 8)
make_circle_plot(cz = FALSE)
## Joining, by = "from"
dev.off()
## quartz_off_screen
## 2
devEMF::emf("chart-output/circle_cz.emf")
make_circle_plot(cz = TRUE)
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
dev.off()
## quartz_off_screen
## 2
devEMF::emf("chart-output/circle_en.emf")
make_circle_plot(cz = FALSE)
## Joining, by = "from"
dev.off()
## quartz_off_screen
## 2
read_pptx() %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = plot_instr(code = {make_circle_plot(cz = TRUE)})) %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = external_img("chart-output/circle_en.svg")) %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = external_img("chart-output/circle_en.emf")) %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = plot_instr(code = {make_circle_plot(cz = FALSE)})) %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = external_img("chart-output/circle_cz.svg")) %>%
add_slide() %>%
ph_with(location = ph_location_fullsize(),
value = external_img("chart-output/circle_cz.emf")) %>%
print(target = "chart-output/charts.pptx")
## Joining, by = "from"
## Joining, by = "from"
## Joining, by = "to"
## Loading required namespace: rsvg
## Joining, by = "from"
source("98_use-preprocessed-data.R")
## Using ',' as decimal and '.' as grouping mark. Use read_delim() for more control.
## Parsed with column specification:
## cols(
## .default = col_double(),
## DESTINATION = col_character()
## )
## See spec(...) for full column specifications.
compar <- dfl_filtered %>%
mutate(flow = paste(to, "to", from)) %>%
select(-from, -to) %>%
full_join(dflo_filtered %>%
mutate(flow = paste(from, "to", to)) %>%
select(-from, -to, value_old = value)
) %>%
replace_na(replace = list(value = 0, value = 0)) %>%
select(flow, value_old, value) %>%
mutate(diff = value - value_old,
diff_pct = diff/value) %>%
arrange(desc(abs(diff_pct)))
## Joining, by = "flow"
compar
compar %>%
gt::gt() %>%
fmt_number(2:4, decimals = 1) %>%
fmt_percent(5, decimals = 1)
| flow | value_old | value | diff | diff_pct |
|---|---|---|---|---|
| South- Eastern Asia to SouthEastern Asia | 1.8 | 0.0 | −1.8 | −Inf% |
| South America to South America | 1.2 | 0.0 | −1.2 | −Inf% |
| Western Europe to Southern Europe | 3.0 | 2.4 | −0.5 | −22.2% |
| Western Europe to Western Europe | 1.8 | 1.5 | −0.3 | −20.4% |
| Western Europe to Western Asia | 3.6 | 3.3 | −0.3 | −8.8% |
| Western Europe to Eastern Europe | 8.5 | 8.1 | −0.3 | −4.2% |
| Western Asia to Northern Africa | 2.5 | 2.4 | −0.0 | −1.0% |
| Western Asia to Southern Asia | 13.4 | 13.2 | −0.1 | −0.9% |
| Western Asia to SouthEastern Asia | 3.5 | 3.5 | −0.0 | −0.5% |
| Western Asia to Western Asia | 8.2 | 8.2 | 0.0 | 0.3% |
| Western Europe to Central Asia | 1.9 | 1.9 | −0.0 | −0.2% |
| Northern America to Caribbean | 2.1 | 2.1 | 0.0 | 0.0% |
| Northern America to Eastern Asia | 1.8 | 1.8 | 0.0 | 0.0% |
| Northern America to Southern Asia | 1.6 | 1.6 | 0.0 | 0.0% |
| Northern America to SouthEastern Asia | 1.8 | 1.8 | 0.0 | 0.0% |
| Northern America to South America | 1.1 | 1.1 | 0.0 | 0.0% |
| Northern America to Central America | 5.3 | 5.3 | 0.0 | 0.0% |
| Eastern Africa to Eastern Africa | 4.7 | 4.7 | 0.0 | 0.0% |
| Eastern Asia to Eastern Asia | 1.2 | 1.2 | 0.0 | 0.0% |
| Eastern Europe to Eastern Europe | 1.4 | 1.4 | 0.0 | 0.0% |
| Eastern Africa to Middle Africa | 1.2 | 1.2 | 0.0 | 0.0% |
| Northern Europe to Southern Asia | 1.2 | 1.2 | 0.0 | 0.0% |
| Western Africa to Western Africa | 1.2 | 1.2 | 0.0 | 0.0% |
| Northern Africa to Eastern Africa | NA | 0.8 | NA | NA |
| Northern Europe to Eastern Europe | NA | 1.0 | NA | NA |
| Western Asia to Eastern Europe | NA | 0.9 | NA | NA |
| Northern Europe to Northern Europe | NA | 0.9 | NA | NA |
| SouthEastern Asia to SouthEastern Asia | NA | 1.8 | NA | NA |
| Western Europe to Southern Asia | NA | 0.8 | NA | NA |